-- CIS 552, Mini-project
-- by Mike Gottlieb and Reilly Grant

-- |Encapsulates poker rules and reactions to player actions.
module Poker(HandRank, rankHand, -- used to score a game
             GamePhase(..), Action(..), GameState, -- used to play
             players, phase,  -- exported functions of GameState record
             -- for use in Main.hs
             getCurrentPlayer, recentHistory, completePot, deal, ante,
             possibleActions, activePlayers, leavingDraw, newGame,
             pickWinner, reset, validateAction, performAction,
             test) where

import List
import Util
import Test.HUnit hiding (test)
import Hand

import qualified Card
import qualified Deck
import qualified Player


--------------------- Phases and Actions --------------------------------------

-- |Action represent the individual operations that a Player can do
--  Determining which actions are valid is dependent on the current
--  GamePhase.
data Action = Bet Int
            | Raise Int
            | See
            | Call
            | Fold
            | Check
            | Discard [Card.T]
            | Help
            | Exit
              
-- Pretty-prints for actions (Discard does not show the actual discarded cards
-- so other players cannot see).
instance Show Action where
    show (Bet n)      = "bets " ++ (show n) ++ "."
    show (Raise n)    = "raises " ++ (show n) ++ "."
    show See          = "sees."
    show Call         = "calls."
    show Fold         = "folds."
    show Check        = "checks."
    show (Discard cs) = "discards " ++ (show $ length cs) ++ "."
    show _            = ""

-- |GamePhase represents the current phase of a round of Poker. Each
--  Bet1 and Bet2 are phases that are entered in case actual betting
--  occurs. They represent the process from a bet to a call (includes
--  possible raising)
data GamePhase = Ante
               | Bet1
               | Draw
               | PostDraw
               | Bet2
               | Final
                 deriving (Show, Enum, Eq)

-- |Links a game phase to the valid actions in that phase.
possibleActions ::  GamePhase -> [String]
possibleActions gp = case gp of Ante     -> ["[b]et", "[ch]eck"]
                                Bet1     -> ["[s]ee", "[r]aise", "[c]all", "[f]old"]
                                Bet2     -> ["[s]ee", "[r]aise", "[c]all", "[f]old"]
                                Draw     -> ["[d]iscard", "[ch]eck"]
                                PostDraw -> ["[b]et", "[ch]eck"]
                                Final    -> ["deal"]

-- |Check that in the current game phase the given action is valid.
validatePhaseToAction :: GamePhase -> Action -> Bool
validatePhaseToAction Ante (Bet _)     = True
validatePhaseToAction Ante Check       = True
validatePhaseToAction Bet1 See         = True
validatePhaseToAction Bet1 (Raise _)   = True
validatePhaseToAction Bet1 Call        = True
validatePhaseToAction Bet1 Fold        = True
validatePhaseToAction Draw (Discard _) = True
validatePhaseToAction Draw Check       = True
validatePhaseToAction PostDraw (Bet _) = True
validatePhaseToAction PostDraw Check   = True
validatePhaseToAction Bet2 See         = True
validatePhaseToAction Bet2 (Raise _)   = True
validatePhaseToAction Bet2 Call        = True
validatePhaseToAction Bet2 Fold        = True
validatePhaseToAction _ _              = False

testPhase gp a = TestCase $ assertBool
                    ("player " ++ show a ++ " in phase " ++ show gp)
                    (validatePhaseToAction gp a)

-- These examples test validatePhaseToAction. 
phaseTests = TestList [testPhase Ante (Bet 10),
                       testPhase Bet1 Fold]

------------- All code ahead deals with the GameState data type ---------------

-- |A GameState represents all the information necessary to describe
--  a current round of Poker at a given time.
data GameState = Poker {players       :: [Player.T],
                        -- dealer for the round
                        dealer        :: Int,
                        -- indexes into players and pot
                        currentPlayer :: Int,
                        -- tracked for each player
                        pot           :: [Int],
                        deck          :: Deck.T,
                        phase         :: GamePhase,
                        -- last person to increase lastBet
                        lastBetter    :: Int,
                        -- initialize to ante amount
                        amountToPlay  :: Int,
                        -- recent actions for display
                        history       :: [String]
                       }
               deriving (Show)

-- |Construct a new game state from a list of players.
newGame :: [Player.T] -> IO GameState
newGame ps = do theDeck <- Deck.shuffle Deck.deck
                return Poker {players       = ps,
                              dealer        = 0,
                              currentPlayer = 1,
                              pot           = [],
                              deck          = theDeck,
                              phase         = Ante,
                              lastBetter    = -1,
                              amountToPlay  = 0,
                              history       = []
                             }
             
-- |Deal 5 cards to each player in the game. The resulting deck
--  is returned from each deal so its state holds.
deal :: GameState -> GameState
deal s = s { players = players',
             deck = deck',
             history = "Cards dealt." : (history s)
           }
         where (players', deck') = deal' (players s) (deck s)
               deal' [] d = ([], d)
               deal' (p:ps) d = let (p', d') = Player.draws p d 5
                                    (rest, d'') = deal' ps d'
                                in (p' : rest, d'')
             
-- |The amount players ante.
defaultAnte = 10

-- |Ante up! Tests if players have less than the ante amount
--  and disables them if so.
ante :: GameState -> GameState
ante s = s {players      = map ante' (players s),
            pot          = take (length $ players s) (repeat defaultAnte),
            amountToPlay = defaultAnte,
            lastBetter   = currentPlayer s,
            phase        = Ante,
            history      = ["All players ante " ++ show defaultAnte ++ "."]
           }
         where ante' p = if Player.money p < defaultAnte
                           then p { Player.inPlay = False }
                           else p { Player.money = Player.money p - defaultAnte }

-- |Changes the state to after the drawing round, play resumes with the next
--  active player after the dealer.
leavingDraw :: GameState -> GameState
leavingDraw s = let nextPlayer = findNextPlayer s (dealer s) 1 in
                s {phase         = PostDraw,
                   currentPlayer = nextPlayer,
                   lastBetter    = nextPlayer
                  }

-- |Reset all players.
reset :: GameState -> GameState
reset s = s { players = map Player.reset (players s) }

-- |Get the player data for the current player.
getCurrentPlayer :: GameState -> Player.T
getCurrentPlayer s = players s !! currentPlayer s

-- |Get the portion of the pot for the current player.
getCurrentPlayerPot :: GameState -> Int
getCurrentPlayerPot s = pot s !! currentPlayer s

-- |Get a "paragraph" describing the actions that have most recently occured.
recentHistory :: GameState -> String
recentHistory s = unwords $ reverse $ take (length (players s)) (history s)

-- |Calculate the complete total in the pot by summing each player's pot.
completePot :: GameState -> Int
completePot s = sum $ pot s

-- |Determines if a particular Action is valid given the GameState.
--  Returns Nothing if the action is valid, otherwise a string with the
--  appropriate error.
validateAction :: Action -> GameState -> Maybe String
validateAction Exit _ = Nothing
validateAction Help _ = Nothing
validateAction a s    = 
    if validatePhaseToAction (phase s) a
        then case a of
          Bet n      -> if validateSpend s n
                         then if validateRaise s n
                               then Nothing
                               else Just "Other players cannot match the bet."
                         else Just "You don't have enough money."

          Raise n    -> if validateSpend s (n + amountToPlay s)
                            then if validateRaise s n
                                then Nothing
                                else Just "Other players cannot match raise."
                            else Just "You don't have enough money."

          See        -> if not (validateCall s)
                            then Nothing
                            else Just "You are in position to call."

          Call       -> if validateCall s
                            then Nothing
                            else Just "You are not in position to call."

          Discard cs -> if validateDiscard s cs
                            then Nothing
                            else Just "You don't have all of those cards."

          _          -> Nothing

        else Just "You cannot perform that action at this time."


-- |Checks that the player attempting to call is in position to do so.
validateCall :: GameState -> Bool
validateCall s = let p = currentPlayer s
                     b = lastBetter s
                     n = length (players s) in
                 findNextPlayer s p 1 == b

-- |Checks that the current player has all of the cards they are trying to
--  discard.
validateDiscard :: GameState -> [Card.T] -> Bool
validateDiscard s cs = let p = getCurrentPlayer s
                           h = Player.hand p in
                       and $ map (flip elem h) cs
                       
-- |Checks that the current player has at least the amount he is attempting
--  to bet or raise. 
validateSpend :: GameState -> Int -> Bool
validateSpend s n = let p = getCurrentPlayer s in
                    Player.money p >= n

-- |Checks that all players can afford the amount that the current player
--  is attempting to bet or raise. (prevents side pots)
validateRaise :: GameState -> Int -> Bool
validateRaise s n = let ps = filter Player.inPlay (players s) in
                    and $ map ((n <=) . Player.money) ps

-- |Perform the current player's action, affecting a change in the current
--  game state. This function actually performs the action and then tests
--  the resulting state for certain special cases like all players but 1
--  folding or folds that proceed to the next round.
performAction :: Action -> GameState -> GameState
performAction a s = 
        -- index of current player
    let cp              = currentPlayer s
        ps              = players s
        nextPhase       = succ $ phase s
        playAmount      = amountToPlay s
        -- current player data
        p               = getCurrentPlayer s
        -- bet in context of current pot
        updateBet d     = Player.bets p $
                            playAmount - getCurrentPlayerPot s + d
        nextPlayerGuess = findNextPlayer s cp 1 
        isLastBet       = lastBetter s == nextPlayerGuess
        -- updates the history with the new action      
        newHistory      = (Player.name p ++ " " ++ show a) : history s
        -- gets the nextplayer given the new state in case of folds
        nextPlayer      = findNextPlayer newState cp 1
        newPot dAmt     = replace cp (playAmount + dAmt) (pot s)
        replacePlayer l = replace cp l ps
        newState        = -- result of performing the action
            case a of 
              Bet n      -> s {pot          = newPot n,
                               players      = replacePlayer $ Player.bets p n,
                               lastBetter   = cp,
                               amountToPlay = playAmount + n,
                               -- bet moves to next phase
                               phase        = nextPhase
                              } 

              Raise n    -> s {pot          = newPot n,
                               players      = replacePlayer (updateBet n),
                               lastBetter   = cp,
                               amountToPlay = playAmount + n
                              }

              See        -> s {pot     = newPot 0,
                               players = replacePlayer (updateBet 0)
                              }

              Call       -> s {pot     = newPot 0,
                               players = replacePlayer (updateBet 0),
                               -- call moves to next phase
                               phase   = nextPhase
                              } 

              Fold       -> s {players = replacePlayer $ Player.folds p,
                               phase   = if isLastBet
                                            -- leaves the betting phase
                                            then nextPhase
                                            else phase s
                              }

              Check      -> s {phase = if isLastBet
                                           -- skips the betting phases
                                           then succ nextPhase
                                           else phase s
                              }

              Discard cs -> let p'       = Player.discards p cs
                                n        = length cs
                                (p'', d) = Player.draws p' (deck s) n in
                                s {players = replacePlayer p'',
                                   deck    = d
                                  }

              Help         -> error "Help action should never be performed."
              Exit         -> error "Exit action should never be performed."

    in newState {history       = newHistory,
                 currentPlayer = nextPlayer,
                 phase         = if activePlayers newState == 1
                                    then Final 
                                    else phase newState
                } -- out of players

-- |Cycles through the players looking for one that's still in play, gives
--  up if the current player is the only one left.
findNextPlayer :: GameState -> Int -> Int -> Int
findNextPlayer s start delta = 
    let next = (start + delta) `mod` (length $ players s) in
    if next == start
      then next
      else if not $ Player.inPlay $ players s !! next
             then findNextPlayer s start $ delta + 1
             else next

-- |Current number of active players.
activePlayers :: GameState -> Int
activePlayers s = countWith Player.inPlay (players s)

-- |Picks the winning hand(s) and distributes the reward(s).
pickWinner :: GameState -> GameState
pickWinner s = 
    -- get the ranks of the hands still in play
    let rankPlayerHand   = rankHand . Player.hand
        winners          = countWith Player.inPlay ps
        reward           = completePot s `div` winners -- split the pot
        ranks            = map rankPlayerHand $ filter Player.inPlay $ players s
        sorted           = reverse $ sort ranks
        playerInPlay x   = if Player.inPlay x 
                              then x { Player.money = Player.money x + reward }
                              else x
        playerIsRanked x = if rankPlayerHand x /= head sorted
                              then x { Player.inPlay = False }
                              else x
        ps               = map playerIsRanked $ players s
        ps'              = map playerInPlay ps
    in s { players = ps' }

------------------------------------------------------------
-- Testing
------------------------------------------------------------

-- |Tests that the result of validateAction is correct.
validated :: Maybe String -> Bool
validated Nothing  = True
validated (Just _) = False

-- Test Data
(player1, theDeck1) = Player.draws (Player.player "Reilly") Deck.deck 5
(player2, theDeck2) = Player.draws (Player.player "Mike") theDeck1 5
(player3, theDeck)  = Player.draws (Player.player "Carl") theDeck2 5

testGameState :: GameState
testGameState = Poker {players       = [player1, player2, player3], 
                       dealer        = 0,
                       currentPlayer = 1, -- player after dealer
                       pot           = [10, 10, 10],
                       deck          = theDeck,
                       phase         = Ante,
                       lastBetter    = 0,
                       amountToPlay  = 10,
                       history       = []
                      }

testEndGameState = testGameState { phase = Final }

playerNotInPlay g i = Player.inPlay (players g !! i) == False

-- HUnit tests for problematic Game situations

testGame1 = let s1 = performAction (Bet 10) testGameState
                s2 = performAction Fold s1
                s3 = performAction (Raise 10) s2 in
            performAction Call s3
                      
caseGame1 = TestCase $ assertBool "Test of call position adjustment" $
              phase testGame1 == Draw && playerNotInPlay testGame1 2

testGame2 = let s1 = performAction Fold testGameState
                s2 = performAction Fold s1 in
            performAction Call s2

caseGame2 = TestCase $ assertBool "Test of all folding" $
                phase testGame2 == Final &&
                playerNotInPlay testGame2 2 &&
                playerNotInPlay testGame2 1
            
testGame3 = let s1 = performAction (Bet 10) testGameState
                s2 = performAction Fold s1
                s3 = performAction (Raise 10) s2 in
            performAction Fold s3
            
caseGame3 = TestCase $ assertBool "Test bet, fold, raise, fold" $
                phase testGame3 == Final &&
                playerNotInPlay testGame3 2 &&
                playerNotInPlay testGame3 1

testGame4 = let s1 = performAction (Bet 10) testGameState
                s2 = performAction Fold s1
                s3 = performAction (Raise 10) s2 in
            performAction Call s3
                            
caseGame4 = TestCase $ assertBool ("Test of proper pot size = " ++ 
                                   show(completePot testGame4) ++ "") $
                phase testGame4 == Draw &&
                playerNotInPlay testGame4 2 &&
                completePot testGame4 == 70

caseEndGame = let endGame = pickWinner testEndGameState in
              TestCase $ assertBool "Test of winner and pot distribution." $
                  [False, True, False] == map Player.inPlay (players endGame) &&
                  [1024, 1054, 1024] == map Player.money (players endGame)
              
gameTests = TestList [caseGame1,
                      caseGame2,
                      caseGame3,
                      caseGame4,
                      caseEndGame
                     ] 

-- |Run all poker tests.
test = runTestTT $ TestList [rankTests, phaseTests, gameTests]
